home *** CD-ROM | disk | FTP | other *** search
/ PsL Monthly 1993 December / PSL Monthly Shareware CD-ROM (December 1993).iso / prgmming / dos / pascal / mathpas.com / MATH.PAS < prev   
Encoding:
Pascal/Delphi Source File  |  1990-09-02  |  6.4 KB  |  242 lines
  1. unit math;
  2. { This unit provides general logarithmic, trigonometric, and
  3.   hyperbolic functions for engineering programs. Needs v4.0+
  4.  
  5.              Copyright 10/07/89 by
  6.              Richard D. Van Fossan
  7.              3701 Ryan St. SE
  8.              Lacey, WA 98503
  9.  
  10.              All rights reserved. Permission is granted for
  11.              non-commercial use. Written permission must be
  12.              obtained for commercial use of this package. This
  13.              package is distributed on an as-is basis, with no
  14.              warranty of any kind. The user takes sole responsibility
  15.              for use of this package, including risk of loss or
  16.              incidental damage or loss.}
  17. {$N+}
  18. interface
  19.    type
  20.    {$IFOPT N+}
  21.    float = extended;
  22.      {$ELSE}
  23.      float = real;
  24.      {$ENDIF}
  25.     function fact (x:float):float; {Computes X!}
  26.     function sgn (x:float):float; {Returns -1,0,+1 based on alg. sign}
  27.    function rad (x:float):float; {Converts deg to radians}
  28.    function deg (x:float):float; {Converts radians to degrees}
  29.    function sec (x:float):float; {Computes sec(x) with x in radians}
  30.    function csc (x:float):float;
  31.    function tan (x:float):float;
  32.    function cot (x:float):float;
  33.    function arcsin (x:float):float;
  34.    function arccos (x:float):float;
  35.    function arccot (x:float):float;
  36.    function arcsec (x:float):float;
  37.    function arccsc (x:float):float;
  38.    function arctan (x,y:float):float;
  39.    function sinh (x:float):float; {Computes Hyperbolic sine}
  40.    function cosh (x:float):float;
  41.    function tanh (x:float):float;
  42.    function csch (x:float):float;
  43.    function sech (x:float):float;
  44.    function coth (x:float):float;
  45.    function arcsinh (x:float):float;
  46.    function arccosh (x:float):float;
  47.    function arctanh (x:float):float;
  48.    function arccsch (x:float):float;
  49.    function arcsech (x:float):float;
  50.    function arccoth (x:float):float;
  51.    function log10 (x:float):float; {Computes common log}
  52.    function exp10 (x:float):float; {Computes common antilog}
  53.     function log (x,y:float):float; {Computes log base y of x}
  54.    function int_pwr (x:float;n:shortint):float; {Raises x to an integer power}
  55.     function power (x,y:float):float; {Raises x to any power y}
  56.    function root (x,y:float):float;  {Computes yth root of x}
  57.    function cube (x:float):float;    {Computes cube of x}
  58.    function cubrt (x:float):float;   {Computes cube root of x}
  59. implementation
  60.  function fact (x:float):float;
  61.         var
  62.             product : float;
  63.             i,j : integer;
  64.         begin
  65.             i := trunc(x);
  66.             product := 1.0;
  67.             if (i < 0.0)
  68.                 then fact := 0.0
  69.                  else if ((i = 0.0) or (i = 1.0))
  70.                     then fact := 1.0
  71.                     else
  72.                         begin
  73.                             for j := 2 to i do product := product * j;
  74.                             fact := product;
  75.                       end;
  76.         end;
  77.     function sgn (x:float):float;
  78.      begin
  79.        if (x = 0.0)
  80.          then sgn := 0.0
  81.          else if (x < 0.0) then sgn := -1.0
  82.                                   else sgn :=  1.0;
  83.      end;
  84.    function rad (x:float):float;
  85.       begin
  86.          rad := x * pi / 180.0;
  87.       end;
  88.    function deg (x:float):float;
  89.       begin
  90.          deg := x * 180.0 / pi;
  91.       end;
  92.    function sec (x:float):float;
  93.       begin
  94.          sec := 1.0/cos(x);
  95.       end;
  96.    function csc (x:float):float;
  97.       begin
  98.          csc := 1.0/sin(x);
  99.       end;
  100.    function tan (x:float):float;
  101.       begin
  102.          tan := sin(x)/cos(x);
  103.       end;
  104.    function cot (x:float):float;
  105.       begin
  106.          cot := cos(x)/sin(x);
  107.       end;
  108.    function arcsin (x:float):float;
  109.       begin
  110.          arcsin := system.arctan(x/sqrt(1-x*x));
  111.       end;
  112.    function arccos (x:float):float;
  113.       begin
  114.          arccos := pi/2.0-arcsin(x);
  115.       end;
  116.    function arccot (x:float):float;
  117.       begin
  118.          arccot := system.arctan(1.0/x);
  119.       end;
  120.    function arcsec (x:float):float;
  121.       begin
  122.          arcsec := arccos(1.0/x);
  123.       end;
  124.    function arccsc (x:float):float;
  125.       begin
  126.          arccsc := arcsin(1.0/x);
  127.       end;
  128.    function arctan (x,y:float):float;
  129.    var a : float;
  130.    begin
  131.      if (x=0.0)
  132.      then
  133.        if (y=0.0)
  134.          then arctan := 0.0
  135.          else arctan := pi/2.0
  136.      else
  137.        if (y=0.0)
  138.          then arctan := 0.0
  139.          else
  140.            begin
  141.              a := system.arctan(abs(y/x));
  142.              if (x>0.0)
  143.                then
  144.                  if (y>0.0)
  145.                    then arctan := a
  146.                    else arctan := -a
  147.                else
  148.                  if (y>0.0)
  149.                    then arctan := a + pi
  150.            end;
  151.    end;
  152.    function sinh (x:float):float;
  153.     begin
  154.       sinh := (exp(x)-exp(-x))/2.0;
  155.     end;
  156.    function cosh (x:float):float;
  157.     begin
  158.       cosh := (exp(x)+exp(-x))/2.0;
  159.     end;
  160.    function tanh (x:float):float;
  161.     begin
  162.     tanh := -exp(-x)/(exp(x)+exp(-x))*2.0+1.0;
  163.   end;
  164. function csch (x:float):float;
  165.   begin
  166.     csch := 1.0/sinh(x);
  167.   end;
  168. function sech (x:float):float;
  169.   begin
  170.     sech := 1.0/cosh(x);
  171.   end;
  172. function coth (x:float):float;
  173.   begin
  174.     coth := 1.0/tanh(x);
  175.   end;
  176. function arcsinh (x:float):float;
  177.   begin
  178.     arcsinh := ln(x+sqrt(x*x+1.0));
  179.   end;
  180. function arccosh (x:float):float;
  181.   begin
  182.     arccosh := ln(x+sqrt(x*x-1.0));
  183.   end;
  184. function arctanh (x:float):float;
  185.   begin
  186.     arctanh := ln((1.0+x)/(1.0-x))/2.0;
  187.   end;
  188. function arccsch (x:float):float;
  189.   begin
  190.     arccsch := ln((sgn(x)*sqrt(x*x+1.0)+1.0)/x);
  191.     end;
  192. function arcsech (x:float):float;
  193.     begin
  194.         arcsech := ln((sqrt(1.0-x*x)+1.0)/x);
  195.     end;
  196. function arccoth (x:float):float;
  197.     begin
  198.         arccoth := ln((x+1.0)/(x-1.0))/2.0;
  199.     end;
  200. function log10 (x:float):float;
  201.     begin
  202.         log10 := ln(x)/ln(10.0);
  203.   end;
  204. function exp10 (x:float):float;
  205.     begin
  206.         exp10 := exp(x*ln(10.0));
  207.     end;
  208. function log (x,y:float):float;
  209.     begin
  210.         log := ln(x)/ln(y);
  211.     end;
  212. function int_pwr (x:float;n:shortint):float;
  213.         var
  214.             m : byte;
  215.             f : float;
  216.      begin
  217.         m := abs(n);
  218.         case m of
  219.             0 : f := 1.0;
  220.             1 : f := x;
  221.             else f := x * int_pwr(x,m - 1);
  222.         end; { case }
  223.         if (n < 0) then int_pwr := 1.0/f
  224.                  else int_pwr := f;
  225.  end; { Int_pwr }
  226. function power (x,y:float):float;
  227.     begin
  228.         power := exp(y*ln(abs(x)));
  229.     end;
  230. function root (x,y:float):float;
  231.     begin
  232.         root := exp((1.0/y)*ln(abs(x)));
  233.     end;
  234. function cube (x:float):float;
  235.     begin
  236.         cube := (x*x*x);
  237.     end;
  238. function cubrt (x:float):float;
  239.     begin
  240.         cubrt := sgn(x)*root(abs(x),3.0);
  241.     end;
  242. end.